Na podstawie zebranych danych widać zdecydowaną tendencję do karłowacenia śledzi. Najwyzsza korelacja występuje między długością śledzi, a temperaturą przy powierzchni wody. Drugą wartość pod względem korelacji miała oscylacja północnoatlantycka, która jest mocno związana z temperaturą. Ponadto parametr temperatury przy powierzchni miał najwyższą wartość ważności. Świadczy to o tym, że zmiany klimatyczne mają największy wpływ na rozmiar śledzi.
library(knitr) #prezentacja wyników
library(dplyr) #data frame
library(ggplot2) #wizualizacja
library(plotly) #interaktywne wykresy
library(caret) #regresja
library(randomForest) #random forest
library(corrplot) # wykres korelacji
set.seed(23)
rawCSV <- read.csv("~/Downloads/sledzie.csv", na.strings = "?")
str(rawCSV)
## 'data.frame': 52582 obs. of 16 variables:
## $ X : int 0 1 2 3 4 5 6 7 8 9 ...
## $ length: num 23 22.5 25 25.5 24 22 24 23.5 22.5 22.5 ...
## $ cfin1 : num 0.0278 0.0278 0.0278 0.0278 0.0278 ...
## $ cfin2 : num 0.278 0.278 0.278 0.278 0.278 ...
## $ chel1 : num 2.47 2.47 2.47 2.47 2.47 ...
## $ chel2 : num NA 21.4 21.4 21.4 21.4 ...
## $ lcop1 : num 2.55 2.55 2.55 2.55 2.55 ...
## $ lcop2 : num 26.4 26.4 26.4 26.4 26.4 ...
## $ fbar : num 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 ...
## $ recr : int 482831 482831 482831 482831 482831 482831 482831 482831 482831 482831 ...
## $ cumf : num 0.306 0.306 0.306 0.306 0.306 ...
## $ totaln: num 267381 267381 267381 267381 267381 ...
## $ sst : num 14.3 14.3 14.3 14.3 14.3 ...
## $ sal : num 35.5 35.5 35.5 35.5 35.5 ...
## $ xmonth: int 7 7 7 7 7 7 7 7 7 7 ...
## $ nao : num 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 ...
Usunięcie elementów, które zawierają niepełne dane (NA)
completeRows <- rawCSV[complete.cases(rawCSV), ]
allRowsNumber <- nrow(rawCSV)
allRowsNumber
## [1] 52582
allRowsNumber - nrow(completeRows)
## [1] 10094
(allRowsNumber - nrow(completeRows)) / allRowsNumber
## [1] 0.1919668
Około 20% procent danych nie posiadało pełnej informacji. Te dane były równo rozłożone w całym zbiorze danych, co pozowliło mi zadecydować, żeby je usunąć.
Krótkie podsumowanie statystyk wartości atrybutów:
summary(completeRows[-1])
## length cfin1 cfin2 chel1
## Min. :19.0 Min. : 0.0000 Min. : 0.0000 Min. : 0.000
## 1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778 1st Qu.: 2.469
## Median :25.5 Median : 0.1111 Median : 0.7012 Median : 5.750
## Mean :25.3 Mean : 0.4457 Mean : 2.0269 Mean :10.016
## 3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936 3rd Qu.:11.500
## Max. :32.5 Max. :37.6667 Max. :19.3958 Max. :75.000
## chel2 lcop1 lcop2 fbar
## Min. : 5.238 Min. : 0.3074 Min. : 7.849 Min. :0.0680
## 1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808 1st Qu.:0.2270
## Median :21.435 Median : 7.0000 Median :24.859 Median :0.3320
## Mean :21.197 Mean : 12.8386 Mean :28.396 Mean :0.3306
## 3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232 3rd Qu.:0.4650
## Max. :57.706 Max. :115.5833 Max. :68.736 Max. :0.8490
## recr cumf totaln sst
## Min. : 140515 Min. :0.06833 Min. : 144137 Min. :12.77
## 1st Qu.: 360061 1st Qu.:0.14809 1st Qu.: 306068 1st Qu.:13.60
## Median : 421391 Median :0.23191 Median : 539558 Median :13.86
## Mean : 519877 Mean :0.22987 Mean : 515082 Mean :13.87
## 3rd Qu.: 724151 3rd Qu.:0.29803 3rd Qu.: 730351 3rd Qu.:14.16
## Max. :1565890 Max. :0.39801 Max. :1015595 Max. :14.73
## sal xmonth nao
## Min. :35.40 Min. : 1.000 Min. :-4.89000
## 1st Qu.:35.51 1st Qu.: 5.000 1st Qu.:-1.90000
## Median :35.51 Median : 8.000 Median : 0.20000
## Mean :35.51 Mean : 7.252 Mean :-0.09642
## 3rd Qu.:35.52 3rd Qu.: 9.000 3rd Qu.: 1.63000
## Max. :35.61 Max. :12.000 Max. : 5.08000
ggplot(completeRows, mapping = aes(x = length)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = cfin1)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = cfin2)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = chel1)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = chel2)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = lcop1)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = lcop2)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = fbar)) + geom_histogram(fill="blue", color="black", binwidth = .01)
ggplot(completeRows, mapping = aes(x = recr)) + geom_histogram(fill="blue", color="black", binwidth = 25000)
ggplot(completeRows, mapping = aes(x = cumf)) + geom_histogram(fill="blue", color="black", binwidth = .01)
ggplot(completeRows, mapping = aes(x = totaln)) + geom_histogram(fill="blue", color="black", binwidth = 10000)
ggplot(completeRows, mapping = aes(x = sst)) + geom_histogram(fill="blue", color="black", binwidth = 0.05)
ggplot(completeRows, mapping = aes(x = sal)) + geom_histogram(fill="blue", color="black", binwidth = 0.01)
ggplot(completeRows, mapping = aes(x = xmonth)) + geom_histogram(fill="blue", color="black", binwidth = 1)
ggplot(completeRows, mapping = aes(x = nao)) + geom_histogram(fill="blue", color="black", binwidth = 1)
corData <- cor(completeRows)
corrplot(corData, method = "number", type = "upper", order="AOE", addCoefasPercent = TRUE)
Wartość korelacji interesuje nas głównie pomiędzy długością śledzia, a innymi zebranymi parametrami. Z wykresu wynika, że zdecydowanie największą bezwzględną korelację posiada długość śledzia z temperaturą powierzchniową wody. Wynosi ona -0.45. Druga co do wartości korelacji jest wartość parametru oscylacji północnoatlantyckiej. Jest ona dość mocno skorelowana też z temperaturą powierzchni wody. Z tej analizy wynika, że klimat ma duży wpływ na rozmiar śledzi.
month_length <- group_by(completeRows, xmonth) %>%
summarize(avg_length = mean(length))
plot <- ggplot(month_length, aes(x=xmonth, y=avg_length)) +
geom_line() +
geom_point() +
geom_smooth()
ggplotly(plot)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
year_group <- completeRows %>%
group_by(recr, add=TRUE) %>%
summarise(avg_length = mean(length)) %>%
arrange(row_number()) %>%
mutate(rok=row_number())
year_group
plot <- ggplot(year_group, aes(x=rok, y=avg_length))+
geom_line() +
geom_point() +
geom_smooth()
ggplotly(plot)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Analizując wykres rozmiarów śledzia w latach widać tendencję do ich karłowacenia. W analizie miesięcznej można zauważyć, że śledzie najwieksze rozmiary osiagaja w okolicach czerwca.
Zbiór treningowy i zbiór testowy został podzielony w proporcjach 70/30. Do funkcji uczącej został wykorzystany algorytm RandomForest i jako metryka RMSE.
cleaned_data_for_training = select(.data = completeRows, -X)
idx <- createDataPartition(cleaned_data_for_training$length, p=0.7, list=F)
training <- cleaned_data_for_training[idx,]
testing <- cleaned_data_for_training[-idx,]
ctrl <- trainControl(
method = "repeatedcv",
number = 2,
repeats = 5)
tunegrid <- expand.grid(mtry = 10:14)
fit <- train(length ~ .,
data = training,
method = "rf",
metric = "RMSE",
tuneGrid=tunegrid,
trControl = ctrl,
ntree = 15)
rfClasses <- predict(fit, newdata = testing)
data_to_summary <- data.frame(obs = testing$length, pred = rfClasses)
defaultSummary(data_to_summary)
## RMSE Rsquared MAE
## 1.1547540 0.5058816 0.9067785
varImp(fit)
## rf variable importance
##
## Overall
## sst 100.0000
## recr 24.9018
## xmonth 13.9992
## lcop1 13.3667
## lcop2 11.1477
## fbar 10.4013
## totaln 8.8732
## cfin2 6.0729
## chel1 2.2363
## chel2 1.7853
## sal 1.5601
## cumf 0.9772
## nao 0.9469
## cfin1 0.0000
ggplot(varImp(fit))
Zdecydowanie największą wartość ważności posiada temperatura powierzchniowa wody i jest większa od kolejnej wartości ponad 4-krotnie, co pokazuje, zdecydowanie, że jest to najważniejszy parametr.